COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "SHEET"
C00004 00003		REAL PAN,TILT,SCALEX,SCALEY,SCALEZ,ORGZ
C00006 00004	SUBR SHOWIJ(ITG K)
C00007 00005	REAL THRESHITG CNT
C00009 00006	SUBR EXTREMA
C00011 00007	α MAIN EXECUTION
C00013 ENDMK
C⊗;
BEGIN "SHEET"
	REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
	REQUIRE "DPYIII[SYS,BGB]" SOURCE_FILE;
	XSUBR APT(ITG X,Y);
	SAFE ITG ARRAY DPYBUF[0:4000];

	DEFINE NN="30";
	DEFINE N2="15";

	SAFE REAL ARRAY BUF[0:NN,0:NN,0:NN];

SUBR BUFTEST;
BEGIN "BUFTEST"
	ITG I,J,K;
	OPEN(1,"DSK",8,3,0,0,0,0);
	LOOKUP(1,"FN3D[SAI,BGB]",0);
	ARRYIN(1,BUF[0,0,0],(NN+1)↑3);
	RELEASE(1);
END "BUFTEST";

SUBR SWAPJK;
BEGIN
	ITG I,J,K;
	FOR I←0 THRU 30 DO
	FOR J←0 THRU 29 DO
	FOR K←J+1 THRU 30 DO
	BUF[I,J,K]↔BUF[I,K,J];
END;

SUBR SWAPIK;
BEGIN
	ITG I,J,K;
	FOR J←0 THRU 30 DO
	FOR I←0 THRU 29 DO
	FOR K←I+1 THRU 30 DO
	BUF[I,J,K]↔BUF[I,J,K];
END;
	REAL PAN,TILT,SCALEX,SCALEY,SCALEZ,ORGZ;
	REAL IX,IY,IZ;
	REAL JX,JY,JZ;
	REAL KX,KY,KZ;
	REAL CX,CY,CZ;

SUBR CAMINIT;
BEGIN "CAMINIT"
	REAL CP,SP,CT,ST;
	CT←COS(TILT);CP←COS(PAN);
	ST←SIN(TILT);SP←SIN(PAN);
	IX ←  CP;	IY ← SP;	IZ ← 0;
	JX ← -SP*CT;	JY ← CP*CT;	JZ ← ST;
	KX ←  SP*ST;	KY ←-CP*ST;	KZ ← CT;
	CX ← 8*KX;	CY ← 8*KY;	CZ ← 8*KZ;
	SCALEX ← 2400;
	SCALEY ← 2400;
END "CAMINIT";

SUBR PROJECT (REFERENCE REAL X,Y,Z);
BEGIN "PROJECT"
	REAL XX,YY,ZZ;
	X ← X-CX;Y ← Y-CY;Z ← SCALEZ*(Z-CZ + ORGZ);
	XX ← IX*X + IY*Y + IZ*Z;
	YY ← JX*X + JY*Y + JZ*Z;
	ZZ ← KX*X + KY*Y + KZ*Z;
	 X ← -SCALEX*XX/ZZ;
	 Y ← -SCALEY*YY/ZZ;
END "PROJECT";
SUBR SHOWIJ(ITG K);
BEGIN "SHOWIJ"
	ITG I,J; REAL X,Y,Z;

	DPYSET(DPYBUF);
	FOR I←0 THRU NN DO
	BEGIN "X"
		X ← (I-N2)/N2;
		Y ← -1;
		Z ← BUF[I,0,K];
		PROJECT(X,Y,Z);AIVECT(X,Y-400);
	FOR J←1 THRU NN DO
	BEGIN "Y"
		X ← (I-N2)/N2;
		Y ← (J-N2)/N2;
		Z ← BUF[I,J,K];
		PROJECT(X,Y,Z);AVECT(X,Y-400);
	END "Y";
	END "X";
	DPYOUT(1);
END "SHOWIJ";
REAL THRESH;ITG CNT;
SAFE ITG ARRAY TRIP[0:2000];

SUBR SHOW3D;
BEGIN "SHOW3D"
	ITG I,J,K,L; REAL X,Y,Z;
	DPYSET(DPYBUF);
	FOR L←0 THRU CNT-1 DO
	⊂ K ← TRIP[L]; J←K % 100; I←J %100;
	  J ← J MOD 100;  K ← K MOD 100;
	  X ← (I-N2)/N2; Y ← (J-N2)/N2;Z ← (K-N2)/N2;
 	  PROJECT(X,Y,Z);APT(X,Y-400);⊃;
	DPYOUT(1);
END "SHOW3D";

SUBR MK3D;
BEGIN "MK3D"
	ITG I,J,K; REAL X,Y,Z;STRING STR;

	OUTSTR("THRESH = ");STR←INCHWL;
	THRESH←REALSCAN(STR,I);
	CNT←0;
	DPYSET(DPYBUF);
	FOR I←0 THRU 30 DO
	FOR J←0 THRU 30 DO
	FOR K←0 THRU 30 DO
	IF BUF[I,J,K]≥ THRESH THEN
	⊂ X ← (I-N2)/N2; Y ← (J-N2)/N2;Z ← (K-N2)/N2;
 	  PROJECT(X,Y,Z);APT(X,Y-400);
TRIP[CNT] ← I*10000 + J*100 + K;
	  CNT←CNT+1;IF CNT=2001 THEN DONE;⊃;
	DPYOUT(1);OUTSTR("NUMBER OF POINTS  "&CVS(CNT)&↓);
END "MK3D";
SUBR EXTREMA;
BEGIN "EXTREMA"

	ITG I,J,K;
	REAL BUFMIN,BUFMAX;
	ITG IMAX,JMAX,KMAX;
	ITG IMIN,JMIN,KMIN;

	S⊂ HRLZI '400000;MOVEM BUFMAX;ORCAM BUFMIN; ⊃;

	FOR I←0 THRU 30 DO
	FOR J←0 THRU 30 DO
	FOR K←0 THRU 30 DO
BEGIN
	BUFMIN ← BUFMIN MIN BUF[I,J,K];
	IF BUFMIN=BUF[I,J,K] THEN ⊂ IMIN←I;JMIN←J;KMIN←K;⊃;

	BUFMAX ← BUFMAX MAX BUF[I,J,K];
	IF BUFMAX=BUF[I,J,K] THEN ⊂ IMAX←I;JMAX←J;KMAX←K;⊃;
END;

OUTSTR("MAX = "&CVG(BUFMAX)&" AT "&CVS(IMAX)&" "&CVS(JMAX)&" "&CVS(KMAX)&↓);
OUTSTR("MIN = "&CVG(BUFMIN)&" AT "&CVS(IMIN)&" "&CVS(JMIN)&" "&CVS(KMIN)&↓);

	SCALEZ ← 1.0;
END "EXTREMA";
α MAIN EXECUTION;
BEGIN "MAIN"
	REAL ROTDEL;STRING STR;
	ITG I,J,K,CHR,KK;

	BUFTEST;
	EXTREMA;

	ROTDEL ← π/8;
	TILT ← π/3; PAN ← π/3; K←1;
	CAMINIT;
	MK3D;

	K ← 0 MAX K MIN NN;

	WHILE TRUE DO ⊂ SHOW3D;CHR ← INCHRW;
	IF CHR=":" THEN TILT←TILT+ROTDEL ELSE
	IF CHR=";" THEN TILT←TILT-ROTDEL ELSE
	IF CHR=")" THEN PAN ←PAN +ROTDEL ELSE
	IF CHR="(" THEN PAN ←PAN -ROTDEL ELSE
	IF CHR="\" THEN ROTDEL←ROTDEL*2 ELSE
	IF CHR="/" THEN ROTDEL←ROTDEL/2 ELSE
	IF CHR="-" THEN K←(IF K≤0 THEN NN ELSE K-1) ELSE
	IF CHR="*" THEN K←(IF K≥NN THEN 0 ELSE K+1) ELSE
	IF CHR="M" THEN MK3D ELSE
	IF CHR="R" THEN ⊂ FOR KK←0 THRU NN DO SHOWIJ(KK);SHOWIJ(K←0); ⊃ ELSE

	IF CHR="S" THEN ⊂ OUTSTR("SCALEZ = "&CVG(SCALEZ));STR←INCHWL;
	IF LENGTH(STR)≠0 THEN SCALEZ←REALSCAN(STR,CHR);SHOWIJ(K);⊃ ELSE

	IF CHR="Z" THEN ⊂ OUTSTR("ORGZ = "&CVG(ORGZ));STR←INCHWL;
	IF LENGTH(STR)≠0 THEN ORGZ←REALSCAN(STR,CHR);SHOWIJ(K);⊃ ELSE
	IF CHR="I" THEN ⊂ SWAPIK;SHOWIJ(K);⊃ ELSE
	IF CHR="J" THEN ⊂ SWAPJK;SHOWIJ(K);⊃ ELSE

	CONTINUE;CAMINIT;⊃;

END "MAIN";

END "SHEET";